Attribute VB_Name = "Module1"
Option Explicit

'///some ad-hoc structures

Public Type typeGraphics
 nColors(15) As Long
 nBrushes(31) As Long
End Type

Public g_nKeyCode(11) As Long
Public g_bConfigDirty As Boolean

'///

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)

Public Const g_nMaxWidth = 8 'must be 8
Public Const g_nMaxHeight = 14

Public Type typeFakeBoxLevel '128 bytes
 b(g_nMaxWidth - 1, g_nMaxHeight - 1) As Byte
 nMaxMoves As Byte
 nCurrentMoves As Byte '??
 nReserved As Byte
 nReserved2 As Byte
 nReserved3 As Long
 nReserved4 As Long
 nReserved5 As Long
End Type

Public g_nSolverType As Long
Public g_nSolverMaxMoves As Long
Public g_tSolverLevel As typeFakeBoxLevel

Public g_nSolverMaxGap As Long
Public g_nSolverMaxNodeCount As Long
Public g_nSolverNodeCount As Long
Public g_bAbort As Boolean

Public g_sRandomState As String

'bit 0-2: x
'bit 3-6: y
'bit 7: horizontal(0)/vertical(1)
Public g_nSolverMoveData(31) As Byte
Public g_nSolverMoves As Long

'nMovesRemaining is moves remaining after this move, -1 means disable check
'return value:
'1=level changed
'2=level is finished
'4=level is impossible (experimental)
'8=eliminated some blocks
Private Function EliminateLevel(ByRef t As typeFakeBoxLevel, Optional ByVal nMovesRemaining As Long = -1) As Long
Dim i As Long, j As Long, k As Long, kk As Long
Dim b(g_nMaxWidth - 1, g_nMaxHeight - 1) As Byte
Dim nCount(14) As Byte
Dim nStartX(14) As Byte
Dim nEndX(14) As Byte
Dim bChanged As Boolean
'///
Do
 bChanged = False
 'check falling
 kk = 0
 For i = 0 To g_nMaxWidth - 1
  k = 0
  For j = g_nMaxHeight - 1 To 0 Step -1
   If t.b(i, j) = 0 Then
    k = k + 1
   ElseIf k > 0 Then
    t.b(i, j + k) = t.b(i, j)
    bChanged = True
    EliminateLevel = EliminateLevel Or 1&
   End If
  Next j
  For j = 0 To k - 1
   t.b(i, j) = 0
  Next j
  kk = kk + (g_nMaxHeight - k)
 Next i
 If kk = 0 Then
  EliminateLevel = EliminateLevel Or 2&
  Exit Function
 End If
 'check eliminating
 Erase b
 'vertical
 For i = 0 To g_nMaxWidth - 1
  k = t.b(i, 0)
  For j = 1 To g_nMaxHeight - 2
   kk = t.b(i, j)
   If k Then
    If k = kk Then
     If k = t.b(i, j + 1) Then
      b(i, j - 1) = 1
      b(i, j) = 1
      b(i, j + 1) = 1
      bChanged = True
      EliminateLevel = EliminateLevel Or 9&
     End If
    End If
   End If
   k = kk
  Next j
 Next i
 'horizontal
 For j = 0 To g_nMaxHeight - 1
  k = t.b(0, j)
  For i = 1 To g_nMaxWidth - 2
   kk = t.b(i, j)
   If k Then
    If k = kk Then
     If k = t.b(i + 1, j) Then
      b(i - 1, j) = 1
      b(i, j) = 1
      b(i + 1, j) = 1
      bChanged = True
      EliminateLevel = EliminateLevel Or 9&
     End If
    End If
   End If
   k = kk
  Next i
  For i = 0 To g_nMaxWidth - 1
   If b(i, j) Then t.b(i, j) = 0
  Next i
 Next j
Loop While bChanged
'///
If nMovesRemaining < 0 Then Exit Function
If nMovesRemaining = 0 Then
 EliminateLevel = EliminateLevel Or 4&
 Exit Function
End If
'///--------experimental check
For i = 0 To 14
 nStartX(i) = &HFF&
Next i
For j = 0 To g_nMaxHeight - 1
 For i = 0 To g_nMaxWidth - 1
  k = t.b(i, j) - 1&
  If k >= 0 And k < 15 Then
   nCount(k) = nCount(k) + 1
   If nStartX(k) > i Then nStartX(k) = i
   If nEndX(k) < i Then nEndX(k) = i
  End If
 Next i
Next j
'///check bad remaining count and forced horizontal move
'TODO: more check
kk = 0
For i = 0 To 14
 Select Case nCount(i)
 Case 1, 2
  EliminateLevel = EliminateLevel Or 4&
  Exit Function
 Case 3
  j = nEndX(i) - nStartX(i)
  If j = 1 Then kk = kk + 1 _
  Else If j > 2 Then kk = kk + j - 2
 Case 4
  j = nEndX(i) - nStartX(i)
  If j = 1 Or j = 2 Then kk = kk + 1 _
  Else If j > 3 Then kk = kk + j - 3
 Case 5
  j = nEndX(i) - nStartX(i)
  If j = 1 Then kk = kk + 1
 End Select
Next i
kk = (kk + 1) \ 2
If kk > nMovesRemaining Then
 Debug.Print "B!n90" 'debug
 EliminateLevel = EliminateLevel Or 4&
 Exit Function
End If
End Function

'no falling check
Private Function EliminateCount(ByRef t As typeFakeBoxLevel, Optional ByVal bCheckOnly As Boolean) As Long
Dim i As Long, j As Long, k As Long, kk As Long
Dim b(g_nMaxWidth - 1, g_nMaxHeight - 1) As Byte
'vertical
For i = 0 To g_nMaxWidth - 1
 k = t.b(i, 0)
 For j = 1 To g_nMaxHeight - 2
  kk = t.b(i, j)
  If k Then
   If k = kk Then
    If k = t.b(i, j + 1) Then
     If bCheckOnly Then
      EliminateCount = 1
      Exit Function
     End If
     b(i, j - 1) = 1
     b(i, j) = 1
     b(i, j + 1) = 1
    End If
   End If
  End If
  k = kk
 Next j
Next i
'horizontal
For j = 0 To g_nMaxHeight - 1
 k = t.b(0, j)
 For i = 1 To g_nMaxWidth - 2
  kk = t.b(i, j)
  If k Then
   If k = kk Then
    If k = t.b(i + 1, j) Then
     If bCheckOnly Then
      EliminateCount = 1
      Exit Function
     End If
     b(i - 1, j) = 1
     b(i, j) = 1
     b(i + 1, j) = 1
    End If
   End If
  End If
  k = kk
 Next i
Next j
If Not bCheckOnly Then
 For j = 0 To g_nMaxHeight - 1
  For i = 0 To g_nMaxWidth - 1
   EliminateCount = EliminateCount + b(i, j)
  Next i
 Next j
End If
End Function

Public Sub SolveIt(Optional ByVal nSolverType As Long = -1, Optional ByVal nMaxModeCount As Long = &H7FFFFFFF)
g_nSolverMaxNodeCount = nMaxModeCount
If nSolverType >= 0 Then g_nSolverType = nSolverType
Select Case g_nSolverType
Case 0
 SolveDFS
End Select
End Sub

Private Sub RandomSolveIt(Optional ByVal nSolverType As Long = -1, Optional ByVal nMaxModeCount As Long = &H7FFFFFFF)
Dim d(31) As Byte, m As Long
m = &H7FFFFFFF
'///
g_nSolverMaxGap = 1
SolveIt nSolverType, nMaxModeCount
If g_bAbort Then Exit Sub
If g_nSolverMoves <= m Then
 m = g_nSolverMoves
 CopyMemory d(0), g_nSolverMoveData(0), 32&
 g_nSolverMaxMoves = m - 1
End If
'///
If m >= 2 And g_nSolverNodeCount < g_nSolverMaxNodeCount Then
 g_nSolverMaxGap = 2
 SolveIt nSolverType, nMaxModeCount
 If g_bAbort Then Exit Sub
 If g_nSolverMoves <= m Then
  m = g_nSolverMoves
  CopyMemory d(0), g_nSolverMoveData(0), 32&
  g_nSolverMaxMoves = m - 1
 End If
End If
'///
If m >= 3 And g_nSolverNodeCount < g_nSolverMaxNodeCount Then
 g_nSolverMaxGap = 99
 SolveIt nSolverType, nMaxModeCount
 If g_bAbort Then Exit Sub
 If g_nSolverMoves <= m Then
  m = g_nSolverMoves
  CopyMemory d(0), g_nSolverMoveData(0), 32&
  g_nSolverMaxMoves = m - 1
 End If
End If
'///
g_nSolverMoves = m
CopyMemory g_nSolverMoveData(0), d(0), 32&
End Sub

Private Sub SolveDFS()
Const mmm As Long = &H80& + g_nMaxHeight * 8&
'///
Dim tMapStack(31) As typeFakeBoxLevel
Dim t As typeFakeBoxLevel
Dim bMove(31) As Byte 'bit 0-2=x, bit 3-6=y, bit 7=horizontal/vertical
Dim bGap(31) As Byte
Dim nStackIndex As Long
Dim i As Long, j As Long, k As Long, kk As Long
Dim n As Long
'///
g_bAbort = False
g_nSolverNodeCount = 0
g_nSolverMoves = &H7FFFFFFF
If g_nSolverMaxMoves < 0 Or g_nSolverMaxMoves >= 32 Then g_nSolverMaxMoves = 32
'///load init data
If EliminateLevel(g_tSolverLevel) And 2& Then
 g_nSolverMoves = 0
 Exit Sub
End If
tMapStack(0) = g_tSolverLevel
'///
Do
 '///load from stack and check movable block
 n = bMove(nStackIndex)
 For n = n To mmm - 1
  i = n And 7&
  j = (n And &H78&) \ 8&
  If n And &H80& Then 'vertical
   If j < g_nMaxHeight - 1 Then
    k = tMapStack(nStackIndex).b(i, j)
    If k <> 0 Then
     kk = tMapStack(nStackIndex).b(i, j + 1)
     If kk <> 0 And k <> kk Then
      t = tMapStack(nStackIndex)
      t.b(i, j) = kk
      t.b(i, j + 1) = k
      Exit For
     End If
    End If
   End If
  Else 'horizontal
   If i < g_nMaxWidth - 1 And j < g_nMaxHeight Then
    k = tMapStack(nStackIndex).b(i, j)
    kk = tMapStack(nStackIndex).b(i + 1, j)
    If (k <> 0 Or kk <> 0) And k <> kk Then
     t = tMapStack(nStackIndex)
     t.b(i, j) = kk
     t.b(i + 1, j) = k
     Exit For
    End If
   End If
  End If
 Next n
 '///
 If n < mmm Then
  'do elimination
  i = g_nSolverMaxMoves
  If g_nSolverMoves <= i Then i = g_nSolverMoves - 1 'only find better solution
  i = i - nStackIndex - 1
  If i < 0 Then i = 0
  i = EliminateLevel(t, i)
  'check movable
  If i And 2& Then
   'find a solution
   If nStackIndex + 1 < g_nSolverMoves Then
    bMove(nStackIndex) = n
    CopyMemory g_nSolverMoveData(0), bMove(0), 32&
    g_nSolverMoves = nStackIndex + 1
   End If
   bMove(nStackIndex) = n + 1
  Else
   'check gap size
   If i And 8& Then j = 0 _
   Else j = bGap(nStackIndex) + 1
   If j >= g_nSolverMaxGap Then i = i Or 4&
   'add to stack
   'If nStackIndex + 2 < g_nSolverMoves And nStackIndex + 1 < g_nSolverMaxMoves And (i And 4&) = 0 Then '<== old code
   If i And 4& Then
    bMove(nStackIndex) = n + 1
   Else
    bMove(nStackIndex) = n
    nStackIndex = nStackIndex + 1
    tMapStack(nStackIndex) = t
    bMove(nStackIndex) = 0
    bGap(nStackIndex) = j
   End If
  End If
  'show progress
  g_nSolverNodeCount = g_nSolverNodeCount + 1
  If (g_nSolverNodeCount And &H3FFF&) = 0 Then DoEvents
  If g_bAbort Or g_nSolverNodeCount > g_nSolverMaxNodeCount Then Exit Do
 Else
  'not movable, up one level
  If nStackIndex > 0 Then
   nStackIndex = nStackIndex - 1
   bMove(nStackIndex) = bMove(nStackIndex) + 1
  Else
   Exit Do
  End If
 End If
Loop
'///
'debug
Debug.Print "Nodes: " + CStr(g_nSolverNodeCount)
End Sub

Private Sub RandomAdd(ByRef t As typeFakeBoxLevel, ByVal nColorStart As Long, ByVal nColorCount As Long, ByVal fExoticProbability As Single)
Dim i0 As Long, j0 As Long
Dim i2 As Long
Dim i As Long, j As Long
Dim n As Long
Dim clr As Long
'///
If Rnd < fExoticProbability Then
 'horizontal and vertical (experimental)
 n = 2 + Int((1! + fExoticProbability) * Rnd)
 i0 = Int((g_nMaxWidth - n) * Rnd)
 i2 = i0 + Int((n + 1) * Rnd)
 If t.b(i2, 0) <> 0 Or t.b(i2, 1) <> 0 Then Exit Sub
 j0 = -1
 For j = g_nMaxHeight - 1 To 0 Step -1
  For i = i0 To i0 + n
   If t.b(i, j) = 0 Then
    j0 = j
    Exit For
   End If
  Next i
  If j0 >= 0 Then Exit For
 Next j
 If j0 >= 0 Then
  j0 = j0 + Int((g_nMaxHeight - j0) * Rnd)
  clr = nColorStart + Int(nColorCount * Rnd)
  For j = 0 To j0 - 1
   For i = i0 To i0 + n
    If i = i2 Then
     If j < g_nMaxHeight - 3 Then t.b(i, j) = t.b(i, j + 3)
    Else
     t.b(i, j) = t.b(i, j + 1)
    End If
   Next i
  Next j
  For i = i0 To i0 + n
   t.b(i, j0) = clr
  Next i
  '///
  j0 = j0 - Int(3 * Rnd)
  If j0 < 0 Then j0 = 0 _
  Else If j0 > g_nMaxHeight - 3 Then j0 = g_nMaxHeight - 3
  For j = j0 To j0 + 2
   t.b(i2, j) = clr
  Next j
 End If
ElseIf Rnd < 0.5! Then
 'horizontal
 n = 2 + Int((1! + fExoticProbability) * Rnd)
 i0 = Int((g_nMaxWidth - n) * Rnd)
 j0 = -1
 For j = g_nMaxHeight - 1 To 0 Step -1
  For i = i0 To i0 + n
   If t.b(i, j) = 0 Then
    j0 = j
    Exit For
   End If
  Next i
  If j0 >= 0 Then Exit For
 Next j
 If j0 >= 0 Then
  j0 = j0 + Int((g_nMaxHeight - j0) * Rnd)
  clr = nColorStart + Int(nColorCount * Rnd)
  For j = 0 To j0 - 1
   For i = i0 To i0 + n
    t.b(i, j) = t.b(i, j + 1)
   Next i
  Next j
  For i = i0 To i0 + n
   t.b(i, j0) = clr
  Next i
 End If
Else
 'vertical
 n = 2 + Int((1! + fExoticProbability) * Rnd)
 i0 = Int(g_nMaxWidth * Rnd)
 j0 = -1
 For j = g_nMaxHeight - 1 To n Step -1
  If t.b(i0, j) = 0 Then
   j0 = j
   Exit For
  End If
 Next j
 If j0 >= 0 Then
  j0 = j0 - n + Int((g_nMaxHeight - j0) * Rnd)
  clr = nColorStart + Int(nColorCount * Rnd)
  For j = 0 To j0 - 1
   t.b(i0, j) = t.b(i0, j + n + 1)
  Next j
  For j = j0 To j0 + n
   t.b(i0, j) = clr
  Next j
 End If
End If
'///
End Sub

Private Function RandomStep(ByRef t As typeFakeBoxLevel, ByVal nMin As Long, ByVal nPossibleCount As Long, ByVal nColorStart As Long, ByVal nColorCount As Long, ByVal fExoticProbability As Single) As Long
Const nMaxSize As Long = 256&
Const nCopySize As Long = nMaxSize \ 8&
Const nChooseSize As Long = nMaxSize \ 32&
Dim m As Long
Dim a As Long, a1 As Long, a2 As Long
Dim i As Long, j As Long, k As Long, kk As Long
Dim ttt(nMaxSize - 1) As typeFakeBoxLevel
Dim nValue(nMaxSize - 1) As Long
Dim nIndex(nMaxSize - 1) As Long
'///
m = nMin + Int(nPossibleCount * Rnd)
'///init
For i = 0 To nMaxSize - 1
 ttt(i) = t
Next i
'///
Do While m > 0
 For i = 0 To nMaxSize - 1
  RandomAdd ttt(i), nColorStart, nColorCount, fExoticProbability
  nValue(i) = EliminateCount(ttt(i)) + Int(m * Rnd)
  nIndex(i) = i
 Next i
 '///run a stupid Shell sort using gap 1,8,23,77,281,...,4^k+3*2^(k-1)+1  ==> O(n^(4/3)), cf. Wikipedia
 a1 = 256&
 a2 = 24&
 Do
  If a1 > 1 Then a = a1 + a2 + 1 Else a = 1
  '///
  For i = a To nMaxSize - 1
   k = nIndex(i)
   kk = nValue(k)
   j = i
   Do
    If nValue(nIndex(j - a)) <= kk Then Exit Do
    nIndex(j) = nIndex(j - a)
    j = j - a
   Loop While j >= a
   nIndex(j) = k
  Next i
  '///
  a1 = a1 \ 4&
  a2 = a2 \ 2&
 Loop While a1 > 0
 '///
 m = m - 1
 '///copy the best one
 If m > 0 Then
  For i = 0 To nCopySize - 1
   ttt(nIndex(nMaxSize - 1 - i)) = ttt(nIndex(i))
  Next i
 End If
Loop
'///choose a best one
i = nIndex(Int(nChooseSize * Rnd))
j = nValue(i)
Debug.Print "RandomStep: " + CStr(j) 'debug
t = ttt(i)
RandomStep = j
End Function

'return value: -1=failed, >=0 success with current move
Private Function RandomScramble(ByRef t As typeFakeBoxLevel, ByVal i As Long, ByVal j As Long) As Long
Dim k As Long, kk As Long
Dim jj As Long, j2 As Long, j3 As Long
Dim t2 As typeFakeBoxLevel
Dim ttt(95) As typeFakeBoxLevel
Dim mmm(95) As Byte
Dim nCandidateCount As Long
Dim bb As Boolean
'///
k = t.b(i, j)
nCandidateCount = 0
'///check swap from left
If i > 0 Then
 If t.b(i - 1, j) <> k And t.b(i - 1, j) <> 0 Then
  bb = True
  If i > 2 Then
   If t.b(i - 3, j) = k And t.b(i - 2, j) = k Then bb = False
  End If
  If j > 1 Then
   If t.b(i - 1, j - 2) = k And t.b(i - 1, j - 1) = k Then bb = False
  End If
  If j > 0 And j < g_nMaxHeight - 1 Then
   If t.b(i - 1, j - 1) = k And t.b(i - 1, j + 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 2 Then
   If t.b(i - 1, j + 1) = k And t.b(i - 1, j + 2) = k Then bb = False
  End If
  If bb Then
   ttt(nCandidateCount) = t
   ttt(nCandidateCount).b(i, j) = t.b(i - 1, j)
   ttt(nCandidateCount).b(i - 1, j) = k
   mmm(nCandidateCount) = (i - 1) Or (j * 8&)
   nCandidateCount = nCandidateCount + 1
  End If
 End If
End If
'///check swap from right
If i < g_nMaxWidth - 1 Then
 If t.b(i + 1, j) <> k And t.b(i + 1, j) <> 0 Then
  bb = True
  If i < g_nMaxWidth - 3 Then
   If t.b(i + 3, j) = k And t.b(i + 2, j) = k Then bb = False
  End If
  If j > 1 Then
   If t.b(i + 1, j - 2) = k And t.b(i + 1, j - 1) = k Then bb = False
  End If
  If j > 0 And j < g_nMaxHeight - 1 Then
   If t.b(i + 1, j - 1) = k And t.b(i + 1, j + 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 2 Then
   If t.b(i + 1, j + 1) = k And t.b(i + 1, j + 2) = k Then bb = False
  End If
  If bb Then
   ttt(nCandidateCount) = t
   ttt(nCandidateCount).b(i, j) = t.b(i + 1, j)
   ttt(nCandidateCount).b(i + 1, j) = k
   mmm(nCandidateCount) = i Or (j * 8&)
   nCandidateCount = nCandidateCount + 1
  End If
 End If
End If
'///check swap from up
If j > 0 Then
 If t.b(i, j - 1) <> k And t.b(i, j - 1) <> 0 Then
  bb = True
  If j > 2 Then
   If t.b(i, j - 3) = k And t.b(i, j - 2) = k Then bb = False
  End If
  If i > 1 Then
   If t.b(i - 2, j - 1) = k And t.b(i - 1, j - 1) = k Then bb = False
  End If
  If i > 0 And i < g_nMaxWidth - 1 Then
   If t.b(i - 1, j - 1) = k And t.b(i + 1, j - 1) = k Then bb = False
  End If
  If i < g_nMaxWidth - 2 Then
   If t.b(i + 1, j - 1) = k And t.b(i + 2, j - 1) = k Then bb = False
  End If
  If bb Then
   ttt(nCandidateCount) = t
   ttt(nCandidateCount).b(i, j) = t.b(i, j - 1)
   ttt(nCandidateCount).b(i, j - 1) = k
   mmm(nCandidateCount) = i Or ((j - 1) * 8&) Or &H80&
   nCandidateCount = nCandidateCount + 1
  End If
 End If
End If
'///check swap from down
If j < g_nMaxHeight - 1 Then
 If t.b(i, j + 1) <> k And t.b(i, j + 1) <> 0 Then
  bb = True
  If j < g_nMaxHeight - 3 Then
   If t.b(i, j + 3) = k And t.b(i, j + 2) = k Then bb = False
  End If
  If i > 1 Then
   If t.b(i - 2, j + 1) = k And t.b(i - 1, j + 1) = k Then bb = False
  End If
  If i > 0 And i < g_nMaxWidth - 1 Then
   If t.b(i - 1, j + 1) = k And t.b(i + 1, j + 1) = k Then bb = False
  End If
  If i < g_nMaxWidth - 2 Then
   If t.b(i + 1, j + 1) = k And t.b(i + 2, j + 1) = k Then bb = False
  End If
  If bb Then
   ttt(nCandidateCount) = t
   ttt(nCandidateCount).b(i, j) = t.b(i, j + 1)
   ttt(nCandidateCount).b(i, j + 1) = k
   mmm(nCandidateCount) = i Or (j * 8&) Or &H80&
   nCandidateCount = nCandidateCount + 1
  End If
 End If
End If
'///check falling from left
If i > 0 Then
 bb = True
 If j > 0 Then
  If t.b(i, j - 1) Then bb = False
 End If
 If j < g_nMaxHeight - 1 Then
  If t.b(i - 1, j + 1) = 0 Then bb = False
 End If
 If t.b(i - 1, 0) Then bb = False
 If bb Then
  For jj = j To 0 Step -1
   t2 = t
   t2.b(i, j) = 0
   For j2 = 0 To jj - 1
    t2.b(i - 1, j2) = t2.b(i - 1, j2 + 1)
   Next j2
   t2.b(i - 1, jj) = k
   '///
   bb = True
   If jj > 1 Then
    If t2.b(i - 1, jj - 2) = k And t2.b(i - 1, jj - 1) = k Then bb = False
   End If
   If jj > 0 And jj < g_nMaxHeight - 1 Then
    If t2.b(i - 1, jj - 1) = k And t2.b(i - 1, jj + 1) = k Then bb = False
   End If
   If jj < g_nMaxHeight - 2 Then
    If t2.b(i - 1, jj + 1) = k And t2.b(i - 1, jj + 2) = k Then bb = False
   End If
   If i > 2 Then
    For j2 = 0 To jj
     kk = t2.b(i - 1, j2)
     If kk Then
      If t2.b(i - 3, j2) = kk And t2.b(i - 2, j2) = kk Then
       bb = False
       Exit For
      End If
     End If
    Next j2
   End If
   '///
   If bb Then
    ttt(nCandidateCount) = t2
    mmm(nCandidateCount) = (i - 1) Or (jj * 8&)
    nCandidateCount = nCandidateCount + 1
   End If
   '///
   If t.b(i - 1, jj) = 0 Then Exit For
  Next jj
 End If
End If
'///check falling from right
If i < g_nMaxWidth - 1 Then
 bb = True
 If j > 0 Then
  If t.b(i, j - 1) Then bb = False
 End If
 If j < g_nMaxHeight - 1 Then
  If t.b(i + 1, j + 1) = 0 Then bb = False
 End If
 If t.b(i + 1, 0) Then bb = False
 If bb Then
  For jj = j To 0 Step -1
   t2 = t
   t2.b(i, j) = 0
   For j2 = 0 To jj - 1
    t2.b(i + 1, j2) = t2.b(i + 1, j2 + 1)
   Next j2
   t2.b(i + 1, jj) = k
   '///
   bb = True
   If jj > 1 Then
    If t2.b(i + 1, jj - 2) = k And t2.b(i + 1, jj - 1) = k Then bb = False
   End If
   If jj > 0 And jj < g_nMaxHeight - 1 Then
    If t2.b(i + 1, jj - 1) = k And t2.b(i + 1, jj + 1) = k Then bb = False
   End If
   If jj < g_nMaxHeight - 2 Then
    If t2.b(i + 1, jj + 1) = k And t2.b(i + 1, jj + 2) = k Then bb = False
   End If
   If i < g_nMaxWidth - 3 Then
    For j2 = 0 To jj
     kk = t2.b(i + 1, j2)
     If kk Then
      If t2.b(i + 3, j2) = kk And t2.b(i + 2, j2) = kk Then
       bb = False
       Exit For
      End If
     End If
    Next j2
   End If
   '///
   If bb Then
    ttt(nCandidateCount) = t2
    mmm(nCandidateCount) = i Or (jj * 8&)
    nCandidateCount = nCandidateCount + 1
   End If
   '///
   If t.b(i + 1, jj) = 0 Then Exit For
  Next jj
 End If
End If
'///--------experimental
'///check remove box under current position to the left
If i > 0 And j > 0 Then
 If t.b(i - 1, j - 1) = 0 And t.b(i - 1, j) <> k And t.b(i, 0) = 0 Then
  bb = True
  If i < g_nMaxWidth - 3 Then
   If t.b(i + 3, j) = k Then bb = False
  End If
  If j > 1 Then 'FIXME: we can break this row
   If t.b(i, j - 2) = k And t.b(i, j - 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 1 Then
   If t.b(i, j - 1) = k And t.b(i, j + 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 2 Then
   If t.b(i, j + 1) = k And t.b(i, j + 2) = k Then bb = False
  End If
  'check first non-empty block
  For jj = j To g_nMaxHeight - 1
   If t.b(i - 1, jj) Then Exit For
  Next jj
  If bb And jj < g_nMaxHeight Then
   For j3 = j To jj
    t2 = t
    t2.b(i - 1, jj) = 0
    For j2 = 0 To j3 - 1
     t2.b(i, j2) = t2.b(i, j2 + 1)
    Next j2
    kk = t.b(i - 1, jj)
    t2.b(i, j3) = kk
    '///
    bb = True
    If j3 > 1 Then
     If t2.b(i, j3 - 2) = kk And t2.b(i, j3 - 1) = kk Then bb = False
    End If
    If j3 < g_nMaxHeight - 1 Then
     If t2.b(i, j3 - 1) = kk And t2.b(i, j3 + 1) = kk Then bb = False
    End If
    If j3 < g_nMaxHeight - 2 Then
     If t2.b(i, j3 + 1) = kk And t2.b(i, j3 + 2) = kk Then bb = False
    End If
    If i < g_nMaxWidth - 2 Then
     For j2 = 0 To j3
      kk = t2.b(i, j2)
      If kk Then
       If t2.b(i + 2, j2) = kk And t2.b(i + 1, j2) = kk Then
        bb = False
        Exit For
       End If
      End If
     Next j2
    End If
    '///
    If bb Then
     'Debug.Assert Testest(t2) 'debug
     ttt(nCandidateCount) = t2
     mmm(nCandidateCount) = (i - 1) Or (j3 * 8&)
     nCandidateCount = nCandidateCount + 1
    End If
   Next j3
  End If
 End If
End If
'///check remove box under current position to the right
If i < g_nMaxWidth - 1 And j > 0 Then
 If t.b(i + 1, j - 1) = 0 And t.b(i + 1, j) <> k And t.b(i, 0) = 0 Then
  bb = True
  If i > 2 Then
   If t.b(i - 3, j) = k Then bb = False
  End If
  If j > 1 Then 'FIXME: we can break this row
   If t.b(i, j - 2) = k And t.b(i, j - 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 1 Then
   If t.b(i, j - 1) = k And t.b(i, j + 1) = k Then bb = False
  End If
  If j < g_nMaxHeight - 2 Then
   If t.b(i, j + 1) = k And t.b(i, j + 2) = k Then bb = False
  End If
  'check first non-empty block
  For jj = j To g_nMaxHeight - 1
   If t.b(i + 1, jj) Then Exit For
  Next jj
  If bb And jj < g_nMaxHeight Then
   For j3 = j To jj
    t2 = t
    t2.b(i + 1, jj) = 0
    For j2 = 0 To j3 - 1
     t2.b(i, j2) = t2.b(i, j2 + 1)
    Next j2
    kk = t.b(i + 1, jj)
    t2.b(i, j3) = kk
    '///
    bb = True
    If j3 > 1 Then
     If t2.b(i, j3 - 2) = kk And t2.b(i, j3 - 1) = kk Then bb = False
    End If
    If j3 < g_nMaxHeight - 1 Then
     If t2.b(i, j3 - 1) = kk And t2.b(i, j3 + 1) = kk Then bb = False
    End If
    If j3 < g_nMaxHeight - 2 Then
     If t2.b(i, j3 + 1) = kk And t2.b(i, j3 + 2) = kk Then bb = False
    End If
    If i > 1 Then
     For j2 = 0 To j3
      kk = t2.b(i, j2)
      If kk Then
       If t2.b(i - 2, j2) = kk And t2.b(i - 1, j2) = kk Then
        bb = False
        Exit For
       End If
      End If
     Next j2
    End If
    '///
    If bb Then
     'Debug.Assert Testest(t2) 'debug
     ttt(nCandidateCount) = t2
     mmm(nCandidateCount) = i Or (j3 * 8&)
     nCandidateCount = nCandidateCount + 1
    End If
   Next j3
  End If
 End If
End If
'///select a random one
If nCandidateCount > 0 Then
 i = Int(nCandidateCount * Rnd)
 t = ttt(i)
 RandomScramble = mmm(i)
Else
 RandomScramble = -1
End If
End Function

''debug
'Private Function Testest(ByRef t As typeFakeBoxLevel) As Boolean
'Dim i As Long, j As Long
'For i = 0 To g_nMaxWidth - 1
' For j = 0 To g_nMaxHeight - 2
'  If t.b(i, j) <> 0 And t.b(i, j + 1) = 0 Then Exit Function
' Next j
'Next i
'Testest = True
'End Function

'0-4 easy,normal,hard,lunatic,extra (broken)
Public Sub RandomTest(Optional ByVal nDifficulty As Long = 1)
Dim m As Long, n As Long
Dim i As Long, j As Long, k As Long, kk As Long
Dim nColorCount As Long
Dim fExoticProbability As Single
Dim nCurrentMoves As Long
Dim t As typeFakeBoxLevel, t2 As typeFakeBoxLevel, t3 As typeFakeBoxLevel
Dim b(g_nMaxWidth - 1, g_nMaxHeight - 1) As Byte
Dim nReferenceSolution(31) As Byte
Dim bbb As Boolean
Dim bCheckForFewerMoves As Boolean
'///
nColorCount = 14 - nDifficulty * 3 - Int(4 * Rnd)
fExoticProbability = 0.03125! * (nDifficulty + 1)
If nColorCount > 15 Then nColorCount = 15 _
Else If nColorCount < 2 Then nColorCount = 2
'///
g_nSolverMaxGap = 99
'///run first step
Do
 Erase t.b
 RandomStep t, 5, 10, 1, nColorCount, fExoticProbability
 '///check solvable
 g_nSolverMaxMoves = 3 - (nDifficulty > 0)
 g_tSolverLevel = t
 g_sRandomState = "Generating first step 1/2"
 SolveIt 0, 2097152
 If g_bAbort Then Exit Sub
 If g_nSolverMoves <= 3 - (nDifficulty > 0) Then
  nCurrentMoves = g_nSolverMoves
  '///check eliminating
  For n = 0 To 3
   Erase b
   bbb = False
   'vertical
   For i = 0 To g_nMaxWidth - 1
    k = t.b(i, 0)
    For j = 1 To g_nMaxHeight - 2
     kk = t.b(i, j)
     If k Then
      If k = kk Then
       If k = t.b(i, j + 1) Then
        b(i, j - 1) = 1
        b(i, j) = 1
        b(i, j + 1) = 1
        bbb = True
       End If
      End If
     End If
     k = kk
    Next j
   Next i
   'horizontal
   For j = 0 To g_nMaxHeight - 1
    k = t.b(0, j)
    For i = 1 To g_nMaxWidth - 2
     kk = t.b(i, j)
     If k Then
      If k = kk Then
       If k = t.b(i + 1, j) Then
        b(i - 1, j) = 1
        b(i, j) = 1
        b(i + 1, j) = 1
        bbb = True
       End If
      End If
     End If
     k = kk
    Next i
   Next j
   '///
   If Not bbb Then Exit For
   '///we need to swap something
   m = 0
   Do While m < 32
    i = Int(g_nMaxWidth * Rnd)
    j = Int(g_nMaxHeight * Rnd)
    If b(i, j) Then
     m = m + 1
     If RandomScramble(t, i, j) >= 0 Then Exit Do
    End If
   Loop
  Next n
  '///
  nCurrentMoves = nCurrentMoves + n
  If n <= 3 And nCurrentMoves <= 3 - (nDifficulty > 0) Then
   '///try to solve again
   g_nSolverMaxMoves = nCurrentMoves
   g_tSolverLevel = t
   g_sRandomState = "Generating first step 2/2"
   SolveIt 0, 2097152
   If g_bAbort Then Exit Sub
   If g_nSolverMoves <= nCurrentMoves Then
    nCurrentMoves = g_nSolverMoves
    '///record reference solution
    For i = 0 To nCurrentMoves - 1
     nReferenceSolution(i) = g_nSolverMoveData(nCurrentMoves - 1 - i)
    Next i
    '///
    Exit Do
   End If
  End If
 End If
Loop
'///add some variant
'If nDifficulty >= 3 Then
' m = 6 + Int(3 * Rnd) - nCurrentMoves
'Else
 m = 3 - (nDifficulty > 0) - (nDifficulty >= 4) * 12
 m = m - nCurrentMoves
 If m > 0 Then 'And nDifficulty < 2
  m = Int((m + 1) * Rnd)
  i = (3 + nDifficulty) \ 2 - nCurrentMoves
  If m < i Then m = i
 End If
 If Rnd < 0.03125! Then m = m + 1
'End If
Do While m > 0
 n = 1024
 Do While n > 0
  '///add random blocks
  t2 = t
  k = RandomStep(t2, 2, 6 - nDifficulty, 1, nColorCount, fExoticProbability)
  If k <= 7 Then
   '///check if it can be eliminated to original state
   t3 = t2
   EliminateLevel t3
   bbb = True
   For j = 0 To g_nMaxHeight - 1
    For i = 0 To g_nMaxWidth - 1
     If t3.b(i, j) <> t.b(i, j) Then
      bbb = False
      Exit For
     End If
    Next i
    If Not bbb Then Exit For
   Next j
   '///
   If bbb Then
    If k > 0 Then 'there is something to eliminate
     Erase b
     'vertical
     For i = 0 To g_nMaxWidth - 1
      k = t2.b(i, 0)
      For j = 1 To g_nMaxHeight - 2
       kk = t2.b(i, j)
       If k Then
        If k = kk Then
         If k = t2.b(i, j + 1) Then
          b(i, j - 1) = 1
          b(i, j) = 1
          b(i, j + 1) = 1
         End If
        End If
       End If
       k = kk
      Next j
     Next i
     'horizontal
     For j = 0 To g_nMaxHeight - 1
      k = t2.b(0, j)
      For i = 1 To g_nMaxWidth - 2
       kk = t2.b(i, j)
       If k Then
        If k = kk Then
         If k = t2.b(i + 1, j) Then
          b(i - 1, j) = 1
          b(i, j) = 1
          b(i + 1, j) = 1
         End If
        End If
       End If
       k = kk
      Next i
     Next j
    Else 'RandomStep failed, something weird happens
     CopyMemory b(0, 0), t2.b(0, 0), g_nMaxWidth * g_nMaxHeight
    End If
    '///we need to swap something
    bbb = False
    k = 0
    Do While k < 128
     i = Int(g_nMaxWidth * Rnd)
     j = Int(g_nMaxHeight * Rnd)
     If b(i, j) Then
      k = k + 1
      t3 = t2
      kk = RandomScramble(t3, i, j)
      If kk >= 0 Then
       If EliminateCount(t3, True) = 0 Then
        bbb = True
        Exit Do
       End If
      End If
     End If
    Loop
    '///
    If bbb Then
     t = t3
     nReferenceSolution(nCurrentMoves) = kk
     nCurrentMoves = nCurrentMoves + 1
     bCheckForFewerMoves = True
     Exit Do
    End If
   End If
  End If
  '///
  n = n - 1
 Loop
 '///
 m = m - 1
Loop
'///scramble it
If Rnd < 0.25! Then
 If nCurrentMoves < 4 Or Rnd < 0.125! Or nDifficulty >= 2 Then
  bbb = False
  k = 0
  Do While k < 128
   i = Int(g_nMaxWidth * Rnd)
   j = Int(g_nMaxHeight * Rnd)
   If t.b(i, j) Then
    k = k + 1
    t3 = t
    kk = RandomScramble(t3, i, j)
    If kk >= 0 Then
     If EliminateCount(t3, True) = 0 Then
      bbb = True
      Exit Do
     End If
    End If
   End If
  Loop
  '///
  If bbb Then
   Debug.Print "Finally add some scrambles" 'debug
   t = t3
   nReferenceSolution(nCurrentMoves) = kk
   nCurrentMoves = nCurrentMoves + 1
   bCheckForFewerMoves = True
  End If
 End If
End If
'///check if there is better solution (maybe false negative)
If bCheckForFewerMoves Then
 If nDifficulty < 4 Then
  g_nSolverMaxMoves = nCurrentMoves - 1
  g_tSolverLevel = t
  i = g_nSolverNodeCount + 1048576
  If nCurrentMoves >= 5 Then i = i + 1048576
  If nCurrentMoves >= 6 Then i = i + 2097152
  g_sRandomState = "Check if there is better solution, only up to " + CStr(i) + " nodes"
  RandomSolveIt 0, i '???
  If g_bAbort Then Exit Sub
 Else
  g_nSolverMoves = 99
 End If
 If g_nSolverMoves <= nCurrentMoves Then
  nCurrentMoves = g_nSolverMoves
 Else
  g_nSolverMoves = nCurrentMoves
  'output reference solution
  For i = 0 To nCurrentMoves - 1
   g_nSolverMoveData(i) = nReferenceSolution(nCurrentMoves - 1 - i)
  Next i
 End If
End If
'///over
t.nMaxMoves = nCurrentMoves
g_tSolverLevel = t
End Sub
